home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / HyperCard Related / APDA HyperCard Toolkits / HyperCard CTB Toolkit 1.0b2 / Source Code / NBPNameList.p < prev    next >
Encoding:
Text File  |  1995-02-07  |  5.0 KB  |  186 lines  |  [TEXT/MPS ]
  1. (*
  2.     NBPNameList([namePattern[,includeTypes]]) -- Return a list of NBP names which match namePattern. Do not
  3.         return the zone name as a part of the names. If the namePattern parameter is not present, return all names
  4.         in the local zone of type "ADSP". Do not return types as a part of the names unless the includeTypes
  5.         parameter is present and non-empty.
  6.  
  7.     To compile and link this file using Macintosh Programmer's Workshop,
  8.  
  9.         pascal -w NBPNameList.p
  10.         link -m ENTRYPOINT -o HyperCommands -rt XFCN=2766 -sn Main=NBPNameList ∂
  11.             NBPNameList.p.o "{MPW}"Libraries:interface.o "{MPW}"Libraries:Libraries:HyperXLib.o
  12.  
  13.     © Copyright 1990 by Apple Computer, Inc.
  14.  
  15.     Initial coding 6/90 by Harry R. Chesley.
  16. *)
  17.  
  18. {$R-}
  19.  
  20. {$S NBPNameList }     { Segment name must be the same as the command name. }
  21.  
  22. unit DummyUnit;
  23.  
  24. interface
  25.  
  26. uses MemTypes, QuickDraw, OSIntf, ToolIntf, CTBUtils, FTIntf, CMIntf, TMIntf, CRMIntf, AppleTalk, HyperXCmd;
  27.  
  28. procedure EntryPoint(paramPtr: XCmdPtr);
  29.     
  30. implementation
  31.  
  32. procedure NBPNameList(paramPtr: XCmdPtr); forward;
  33.  
  34. procedure EntryPoint(paramPtr: XCmdPtr);
  35.  
  36.     begin
  37.         NBPNameList(paramPtr);
  38.     end;
  39.  
  40. procedure NBPNameList(paramPtr: XCmdPtr);
  41.  
  42.     {$I CTBUtil.inc}
  43.  
  44.     const kNBPTimeOutVal = 8;            { Re-try NBP PLookupName every 3 seconds. }
  45.         kNBPRetryCount = 5;                { For five times. }
  46.         kMaxLookupNames = 200;            { Maximum number of names to lookup. }
  47.         kLookupBufferSize = kMaxLookupNames*(sizeof(EntityName)+sizeof(AddrBlock)+4);
  48.         kReturn = 13;
  49.  
  50.     var i: integer;
  51.         s: Str255;
  52.         includeTypes: boolean;
  53.         nameToLookup: EntityName;
  54.         nameBuffer: array [1..100] of SignedByte;
  55.         pBlock: MPPParamBlock;
  56.         lookupBuf: Ptr;
  57.         result: Handle;
  58.         resultSize: longInt;
  59.         name: EntityName;
  60.         addr: AddrBlock;
  61.         p: Ptr;
  62.  
  63.     procedure Fail(errMsg: Str255); { set theResult and quit }
  64.         begin
  65.             { Dispose any buffers we managed to allocate before failing. }
  66.             if lookupBuf <> nil then DisposPtr(lookupBuf);
  67.             if result <> nil then DisposHandle(result);
  68.             paramPtr^.returnValue := PasToZero(paramPtr,errMsg);
  69.             exit(NBPNameList);
  70.         end;
  71.  
  72.     procedure NBPPack(en: EntityName; var s: Str255);
  73.         { Pack an EntityName structure into a single string in the form "<object>:<type>@<zone>". }
  74.     
  75.         begin
  76.             s := en.objStr;
  77.             if (en.typeStr <> '=') and (en.typeStr <> '') then s := Concat(s,Concat(':',en.typeStr));
  78.             if (en.zoneStr <> '*') and (en.zoneStr <> '') then s := Concat(s,Concat('@',en.zoneStr));
  79.         end;
  80.     
  81.     procedure NBPUnpack(var s: Str255; var en: EntityName);
  82.         { Unpack a string of the form "<object>:<type>@<zone>" into an EntityName structure. }
  83.     
  84.         var o, o2: integer;
  85.     
  86.         begin
  87.             o := Pos(':',s);
  88.             if o > 0 then
  89.                 begin
  90.                     en.objStr := Copy(s,1,o-1);
  91.                     o2 := Pos('@',s);
  92.                     if o2 > o then
  93.                         begin
  94.                             en.typeStr := Copy(s,o+1,o2-o-1);
  95.                             en.zoneStr := Copy(s,o2+1,length(s)-o2);
  96.                         end
  97.                     else
  98.                         begin
  99.                             en.typeStr := Copy(s,o+1,length(s)-o);
  100.                             en.zoneStr := '*';
  101.                         end;
  102.                 end
  103.             else
  104.                 begin
  105.                     en.typeStr := '=';
  106.                     o := Pos('@',s);
  107.                     if o > 0 then
  108.                         begin
  109.                             en.objStr := Copy(s,1,o-1);
  110.                             en.zoneStr := Copy(s,o+1,length(s)-o);
  111.                         end
  112.                     else
  113.                         begin
  114.                             en.objStr := s;
  115.                             en.zoneStr := '*';
  116.                         end;
  117.                 end;
  118.         end;
  119.  
  120.     begin
  121.         lookupBuf := nil;
  122.         result := nil;
  123.  
  124.         { Check the parameter count. }
  125.         if paramPtr^.paramCount > 2 then Fail('Invalid parameter count');
  126.  
  127.         { Load AppleTalk. }
  128.         FailOSErr(OpenDriver('.MPP', i));
  129.  
  130.         { Get the name pattern. }
  131.         if ParmPresent(1) then GetStrParm(1,s)
  132.         else s := '=:ADSP';
  133.         NBPUnpack(s,nameToLookup);
  134.         NBPSetEntity(@nameBuffer,nameToLookup.objStr,nameToLookup.typeStr,nameToLookup.zoneStr);
  135.         { Decide whether to include type information. }
  136.         includeTypes := ParmPresent(2);
  137.  
  138.         { Prepare the name lookup request. }
  139.         lookupBuf := NewPtr(kLookupBufferSize);
  140.         if lookupBuf = nil then Fail('Out of memory');
  141.         with pBlock do
  142.             begin
  143.                 ioCompletion := nil;
  144.                 interval := kNBPTimeOutVal;
  145.                 count := kNBPRetryCount;
  146.                 entityPtr := @nameBuffer;
  147.                 retBuffPtr := lookupBuf;
  148.                 retBuffSize := kLookupBufferSize;
  149.                 maxToGet := kMaxLookupNames;
  150.                 numGotten := 0;
  151.             end;
  152.         FailOSErr(PLookupName(@pBlock,false));
  153.  
  154.         { Pry the names out of the lookup buffer. }
  155.         result := NewHandle(0);
  156.         resultSize := 0;
  157.         if result = nil then Fail('out of memory');
  158.         for i := 1 to pBlock.numGotten do
  159.             begin
  160.                 if NBPExtract(lookupBuf,pBlock.numGotten,i,name,addr) <> noErr then Fail('Name extraction error');
  161.                 if not includeTypes then name.typeStr := '';
  162.                 name.zoneStr := '';
  163.                 NBPPack(name,s);
  164.                 resultSize := resultSize + length(s) + 1;
  165.                 SetHandleSize(result,resultSize);
  166.                 if MemError <> noErr then Fail('Out of memory');
  167.                 BlockMove(Ptr(ord4(@s)+1),pointer(ord4(result^)+resultSize-length(s)-1),length(s));
  168.                 p := pointer(ord4(result^)+resultSize-1);
  169.                 p^ := kReturn;
  170.             end;
  171.  
  172.         { Get rid of the lookup buffer. }
  173.         DisposPtr(lookupBuf);
  174.  
  175.         { Terminate and return the result. }
  176.         if resultSize > 0 then
  177.             begin
  178.                 p := pointer(ord4(result^)+resultSize-1);
  179.                 p^ := 0;
  180.                 paramPtr^.returnValue := result;
  181.             end
  182.         else DisposHandle(result);
  183.     end;
  184.  
  185. end.
  186.